home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qbnws202.zip / MOUSECUR.ZIP / MOUSCURS.BAS < prev    next >
BASIC Source File  |  1991-06-01  |  15KB  |  511 lines
  1. 'MOUSCURS.BAS  by Dr. Warren G. Lieuallen    v 3.1    3/3/91
  2. '  a program to "automate" drawing a graphic mouse cursor
  3. '  allows copying of cursor mask to screen mask, and clearing of either,
  4. '  automatic screen mask "expansion", user-definable hot-spot, on-screen
  5. '  representation of mouse on foreground and background, saving of
  6. '  either entire sub-program or only DATA, supports full-color and
  7. '  all screen modes!, loading of saved cursors
  8.  
  9. DEFINT A-Z
  10. OPTION BASE 1
  11. 'DECLARE FUNCTION QExist (filname$)
  12. DECLARE FUNCTION Dir$ (filename$)
  13. DECLARE SUB CopyIt ()
  14. DECLARE SUB ClearIt (x)
  15. DECLARE SUB Active ()
  16. DECLARE SUB DeActive ()
  17. DECLARE SUB Expand ()
  18. DECLARE SUB NewMousCurs ()
  19. DECLARE SUB EndIt (x, ctype)
  20. DECLARE SUB NewCursMask ()
  21.  
  22. ' Define Variable type for Interrupt
  23. TYPE RegType
  24.      ax    AS INTEGER
  25.      bx    AS INTEGER
  26.      cx    AS INTEGER
  27.      dx    AS INTEGER
  28.      bp    AS INTEGER
  29.      si    AS INTEGER
  30.      di    AS INTEGER
  31.      flags AS INTEGER
  32. END TYPE
  33.  
  34. DIM reg AS RegType, MousCurs&(32), CursMask(16, 32), CrsMsk&(64)
  35. DIM SHARED ratx!, raty!
  36. DECLARE SUB INTERRUPT (intnum, reg1 AS RegType, reg2 AS RegType)
  37.  
  38. FOR i = 1 TO 16
  39.    FOR j = 1 TO 16
  40.       CursMask(i, j) = -2             'Initialize masks to blanks
  41.       CursMask(i, j + 16) = 1
  42.    NEXT j
  43. NEXT i
  44.  
  45. FOR i = 17 TO 32
  46.    MousCurs&(i) = 65535
  47. NEXT i
  48. hotx = 5: hoty = 0
  49.  
  50. 'CALL QCrtMode(ctype, ccols)
  51. CLS : PRINT : PRINT "Enter graphics type:"
  52. PRINT : PRINT "1. Hercules"
  53. PRINT "2. CGA"
  54. PRINT "3. EGA"
  55. PRINT "4. VGA"
  56. PRINT : INPUT ctype
  57.  
  58. IF ctype = 1 THEN
  59.    DEF SEG = &H40
  60.    POKE &H49, 6                        'Adjustment for Hercules screen
  61.    DEF SEG
  62. END IF
  63.  
  64. reg.ax = 0
  65. CALL INTERRUPT(&H33, reg, reg)         'Reset driver and read status
  66. IF reg.ax = 0 THEN GOTO nomouse
  67.  
  68. SELECT CASE ctype
  69.    CASE 1                              'Hercules
  70.       SCREEN 3
  71.       ratx! = 1: raty! = 1
  72.       sx = 9: sy = 14
  73.    CASE 2                              'CGA?
  74.       SCREEN 2
  75.       ratx! = 640 / 720: raty! = 200 / 348
  76.       sx = 8: sy = 8
  77.    CASE 3                              'EGA?
  78.       SCREEN 9
  79.       ratx! = 640 / 720: raty! = 350 / 348
  80.       sx = 8: sy = 14
  81.    CASE 4                              'VGA
  82.       SCREEN 12
  83.       ratx! = 640 / 720: raty! = 398 / 348
  84.       sx = 8: sy = 16
  85.    CASE ELSE
  86.       PRINT : PRINT "Maybe you should select one of the supported graphics modes!"
  87.       PRINT : PRINT "Please try again."
  88.       END
  89. END SELECT
  90.  
  91. q1 = INT(635 * ratx!): q2 = INT(167 * raty!): q3 = INT(656 * ratx!)
  92.  
  93. FOR i = 1 TO 32
  94.    READ wrd
  95.    Msk$ = Msk$ + MKI$(wrd)
  96. NEXT i
  97.  
  98. reg.ax = 9
  99. reg.bx = 5: reg.cx = 0
  100. reg.dx = SADD(Msk$)
  101. CALL INTERRUPT(&H33, reg, reg)      'Define graphic cursor
  102.  
  103. reg.ax = 4
  104. reg.cx = 270 * ratx!: reg.dx = 150 * raty!
  105. CALL INTERRUPT(&H33, reg, reg)      'Position mouse cursor
  106.  
  107. reg.ax = 1
  108. CALL INTERRUPT(&H33, reg, reg)      'Show mouse cursor
  109.  
  110. IF ctype > 2 THEN COLOR 15
  111. LOCATE 1, 13: PRINT "Mouse Cursor Design Tool   by Dr. Warren G. Lieuallen"
  112. LINE (90 * ratx!, 13 * raty!)-(600 * ratx!, 13 * raty!)
  113. IF ctype > 2 THEN COLOR 14
  114. LOCATE 19, 40: PRINT "Expand"
  115. LOCATE 20, 21: PRINT "-> Copy ->"
  116. LOCATE 21, 4: PRINT "   Clear                            Clear"
  117. LOCATE 22, 61: PRINT "Activate Cursor": LOCATE 23, 60: PRINT "DeActivate Cursor"
  118. LOCATE 24, 5: PRINT "Save Data      Save Program      Load Cursor     Exit";
  119. IF ctype > 2 THEN COLOR 7
  120. LOCATE 2, 21: PRINT "Dec."; TAB(27); "Hex": LOCATE 2, 54: PRINT "Dec."; TAB(60); "Hex"
  121. LOCATE 9, 71: PRINT "Custom": LOCATE 10, 71: PRINT "Cursor": LOCATE 11, 69: PRINT "Appearance"
  122. LOCATE 20, 3: PRINT "(Cursor Mask)": LOCATE 20, 36: PRINT "(Screen Mask)"
  123.  
  124. IF ctype > 2 THEN COLOR 12
  125. LINE (6 * ratx!, 26 * raty!)-(155 * ratx!, 252 * raty!), , B   'Box around cursor mask
  126. LINE (303 * ratx!, 26 * raty!)-(453 * ratx!, 252 * raty!), , B 'Box around screen mask
  127. IF ctype > 2 THEN COLOR 7
  128. LINE (q1 - 2, q2 - 2)-(q3 - 2, q2 + 18), , B'Box around cursor-shape
  129. LINE (q3 - 2, q2 - 2)-(q3 + 18, q2 + 18), , BF'Inverse box
  130.  
  131. FOR i = 0 TO 15
  132.    LOCATE i + 3, 2
  133.    FOR j = 0 TO 15
  134.       PRINT ".";
  135.    NEXT j
  136.    LOCATE i + 3, 35
  137.    FOR j = 0 TO 15
  138.       PRINT "1";
  139.    NEXT j
  140. NEXT i
  141.  
  142.  
  143. FOR i = 1 TO 16
  144.    LOCATE 2 + i, 21
  145.    PRINT "0"; TAB(27); "0"
  146.    LOCATE 2 + i, 54
  147.    PRINT "65535"; TAB(60); "FFFF"
  148. NEXT i
  149. reg.ax = 3
  150.  
  151. DO
  152.    CALL INTERRUPT(&H33, reg, reg)   'Position and button status
  153.   
  154.    IF reg.bx = 1 THEN               'Left Button pressed
  155.       x = reg.cx \ sx + 1: y = reg.dx \ sy + 1
  156.       'LOCATE 22, 20: PRINT y; ","; x
  157.       IF y = 19 THEN CALL Expand: CALL NewMousCurs
  158.       IF y = 20 THEN CALL CopyIt: CALL NewMousCurs
  159.       IF y = 21 THEN CALL ClearIt(x): CALL NewMousCurs
  160.       IF y = 22 THEN CALL Active: reg.ax = 3
  161.       IF y = 23 THEN CALL DeActive: reg.ax = 3
  162.       IF y = 24 THEN CALL EndIt(x, ctype): reg.ax = 3
  163.       IF y < 3 OR y > 18 THEN GOTO toobig
  164.       IF x < 2 OR x > 50 THEN GOTO toobig
  165.       IF x > 17 AND x < 35 THEN GOTO toobig
  166.       IF x > 34 THEN x = x - 17
  167.       reg.ax = 2: CALL INTERRUPT(&H33, reg, reg)   'Hide cursor
  168.       CursMask(y - 2, x - 1) = NOT CursMask(y - 2, x - 1)
  169.      
  170.       IF x < 18 THEN
  171.          LOCATE y, x: PRINT CHR$(48 + (CursMask(y - 2, x - 1)))
  172.       ELSE
  173.          LOCATE y, x + 17: PRINT CHR$(48 + (CursMask(y - 2, x - 1)))
  174.       END IF
  175.      
  176.       reg.ax = 1: CALL INTERRUPT(&H33, reg, reg)   'Show cursor
  177.       reg.ax = 3
  178.      
  179.       CALL NewMousCurs
  180.   
  181.    ELSEIF reg.bx = 2 THEN         'Right button pressed
  182.       hotx = reg.cx \ sx - 1: hoty = reg.dx \ sy - 2
  183.       IF hotx < 0 OR hotx > 16 THEN GOTO toobig
  184.       IF hoty < 0 OR hoty > 16 THEN GOTO toobig
  185.       CursMask(hoty + 1, hotx + 1) = NOT CursMask(hoty + 1, hotx + 1)
  186.      
  187.       reg.ax = 2: CALL INTERRUPT(&H33, reg, reg)   'Hide cursor
  188.       LOCATE hoty + 3, hotx + 2: PRINT CHR$(88 + 40 * (CursMask(hoty + 1, hotx + 1) = -2))
  189.       reg.ax = 1: CALL INTERRUPT(&H33, reg, reg)   'Show cursor
  190.       reg.ax = 3
  191.     
  192.       CALL NewMousCurs
  193.   
  194.    END IF
  195. toobig:
  196. LOOP
  197.  
  198. END
  199.  
  200. nomouse:
  201. SCREEN 0
  202. PRINT : PRINT "  Sorry, but the program REQUIRES a mouse."
  203. PRINT : PRINT "    Press any key to exit...."
  204. WHILE INKEY$ = "": WEND
  205. END
  206.  
  207. DATA &HF3FF
  208. DATA &HE1FF
  209. DATA &HE1FF
  210. DATA &HE1FF
  211. DATA &HE07F
  212. DATA &HE00F
  213. DATA &HE001
  214. DATA &H8000
  215. DATA &H0000
  216. DATA &H0000
  217. DATA &H0000
  218. DATA &H0000
  219. DATA &H0000
  220. DATA &H0000
  221. DATA &H8001
  222. DATA &HC003
  223.  
  224. DATA &H0C00
  225. DATA &H1200
  226. DATA &H1200
  227. DATA &H1200
  228. DATA &H1380
  229. DATA &H1270
  230. DATA &H124E
  231. DATA &H7249
  232. DATA &H9249
  233. DATA &H9001
  234. DATA &H9001
  235. DATA &H8001
  236. DATA &H8001
  237. DATA &H8001
  238. DATA &H4002
  239. DATA &H3FFC
  240.  
  241. SUB Active
  242. SHARED reg AS RegType, MousCurs&(), hotx, hoty
  243.  
  244.    FOR i = 17 TO 32
  245.       CMsk$ = CMsk$ + MID$(MKL$(MousCurs&(i)), 1, 2)
  246.    NEXT i
  247.    FOR i = 1 TO 16
  248.       CMsk$ = CMsk$ + MID$(MKL$(MousCurs&(i)), 1, 2)
  249.    NEXT i
  250.  
  251.    reg.ax = 9
  252.    reg.bx = hotx: reg.cx = hoty
  253.    reg.dx = SADD(CMsk$)
  254.    CALL INTERRUPT(&H33, reg, reg)      'Define custom graphic cursor
  255.  
  256. END SUB
  257.  
  258. SUB ClearIt (x)
  259. SHARED CursMask(), MousCurs&()
  260.  
  261.    IF x < 20 THEN
  262.       FOR i = 1 TO 16
  263.          FOR j = 1 TO 16
  264.             CursMask(i, j) = -2
  265.          NEXT j
  266.          MousCurs&(i) = 0
  267.       NEXT i
  268.      
  269.       FOR y = 3 TO 18
  270.          FOR x = 1 TO 16
  271.             LOCATE y, x + 1: PRINT CHR$(48 + (CursMask(y - 2, x)))
  272.          NEXT x
  273.       NEXT y
  274.  
  275.    ELSE
  276.       FOR i = 1 TO 16
  277.          FOR j = 1 TO 16
  278.             CursMask(i, j + 16) = 1
  279.          NEXT j
  280.          MousCurs&(i + 16) = 65535
  281.       NEXT i
  282.       FOR y = 3 TO 18
  283.          FOR x = 17 TO 32
  284.             LOCATE y, x + 18: PRINT CHR$(48 + (CursMask(y - 2, x)))
  285.          NEXT x
  286.       NEXT y
  287.  
  288.    END IF
  289.  
  290. END SUB
  291.  
  292. SUB CopyIt
  293. SHARED CursMask(), MousCurs&()
  294.  
  295.    FOR i = 1 TO 16
  296.       MousCurs&(i + 16) = 0
  297.       FOR j = 1 TO 16
  298.          CursMask(i, j + 16) = NOT CursMask(i, j)
  299.       NEXT j
  300.    NEXT i
  301.   
  302.    FOR y = 3 TO 18
  303.       FOR x = 17 TO 32
  304.          LOCATE y, x + 18: PRINT CHR$(48 + (CursMask(y - 2, x)))
  305.       NEXT x
  306.    NEXT y
  307.  
  308. END SUB
  309.  
  310. SUB DeActive
  311. SHARED Msk$, reg AS RegType
  312.  
  313.    r